home *** CD-ROM | disk | FTP | other *** search
/ The World of Computer Software / The World of Computer Software.iso / netbon.zip / TESTQUE2.PAS < prev    next >
Pascal/Delphi Source File  |  1991-09-05  |  3KB  |  109 lines
  1. {
  2.   TESTQUE2 - Program to test NetWare QMS functions
  3.              by Richard S. Sadowsky
  4.  
  5.   This program attempts to find the queue created by TESTQUE. If found, this
  6.   program attachs as a queue server and processes a job (if one exists). In
  7.   the case of this test program, processes the job consists of reading the job
  8.   and a string out of the job file.
  9. }
  10. {$S-,R-,I-}
  11. program TestQue2;
  12. uses
  13.   {$IFDEF Windows}
  14.   TpString,
  15.   WinCrt,
  16.   {$ELSE}
  17.   OpString,
  18.   {$ENDIF}
  19.   NetBind,
  20.   NetQue;
  21. {$IFDEF Windows}
  22. type
  23.   StringPtr = ^String;
  24. {$ENDIF}
  25.  
  26.   procedure Abort(S : String);
  27.   begin
  28.     WriteLn(S);
  29.     Halt;
  30.   end;
  31.  
  32. var
  33.   HasProp : Boolean;
  34.   QueueID : LongInt;
  35.   Result         : Byte;
  36.   ObjectType,
  37.   Num,
  38.   JobNo          : Word;
  39.   ObjectFlag,
  40.   ObjectSec,
  41.   PropFlag       : Byte;
  42.   SaveExitProc : Pointer;
  43.   JobEntry : JobEntryType;
  44.   QueueName : ObjNameStr;
  45.   F : File;
  46.   S : String;
  47.  
  48. const
  49.   Attached :Boolean = False;
  50.   OurQueName = 'RICH_Q';
  51.  
  52.   {$F+}
  53.   procedure OurExitProc;
  54.   begin
  55.     ExitProc := SaveExitProc;
  56.     if Attached then begin
  57.       {detach from queue before terminating}
  58.       Result := DetachQueueServerFromQueue(QueueID);
  59.       if Result <> 0 then WriteLn('Error ', HexB(Result), ' detaching from queue');
  60.     end;
  61.   end;
  62.  
  63. begin
  64.   SaveExitProc := ExitProc;
  65.   ExitProc := @OurExitProc;
  66.  
  67.   {scan bindery for our queue}
  68.   ObjectType := bindJobQueue;
  69.   QueueName := OurQueName;
  70.   Result := ScanObject(ObjectType, QueueName, QueueID, ObjectFlag,
  71.                        ObjectSec, HasProp);
  72.   if Result <> 0 then Abort('QUEUE: ' + OurQueName + ' not found');
  73.  
  74.   {attach to the queue as a queue server}
  75.   Result := AttachQueueServerToQueue(QueueID);
  76.   if Result <> 0 then Abort('Error ' + HexB(Result) + ' attaching to queue');
  77.   Attached := True;
  78.  
  79.   {service a queue job}
  80.   Result := ServiceQueueJobAndOpenFile(QueueID, $FFFF, JobEntry);
  81.   if Result <> 0 then Abort('Error ' + HexB(Result) + ' servicing queue job');
  82.  
  83.   {read the job we're servicing}
  84.   Result := ReadJobEntry(QueueID, Swap(JobEntry.JobNumber), JobEntry);
  85.   if Result <> 0 then WriteLn('Error ' + HexB(Result) + ' reading job from queue');
  86.  
  87.   {display info from this job}
  88.   Move(JobEntry.TextJobDesc,S[1], SizeOf(TextJobField));
  89.   S[0] := Char(SizeOf(TextJobField));
  90.   WriteLn(S);
  91.   WriteLn(StringPtr(@JobEntry.ClientRecord)^);
  92.  
  93.   {open the queue file}
  94.   Assign(F, 'NETQ');
  95.   Reset(F, 1);
  96.   if IoResult <> 0 then Abort('Can not open NETQ');
  97.  
  98.   {read the queue file}
  99.   BlockRead(F, S, SizeOf(S), Num);
  100.   if IoResult <> 0 then Abort('Can not read NETQ');
  101.  
  102.   {display text from file}
  103.   WriteLn(S);
  104.  
  105.   {close the DOS handle for the queue file}
  106.   Close(F);
  107.   if IoResult <> 0 then Abort('Can not Close NETQ');
  108. end.
  109.